home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SCREEN.SWG / 0037_Box Shadows.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-02  |  2KB  |  105 lines
  1. {
  2. KIMBA DOUGHTY
  3.  
  4. > could someone tell me how to do a shadow Window.. you know the Type that
  5. > has a Window then a shadow of what is under the Window in color 8 or dark
  6. > gray... Either in Inline assembly or Straight Pascal...
  7. }
  8.  
  9. Unit shadow;
  10.  
  11. Interface
  12.  
  13. Uses
  14.   Crt, Dos;
  15.  
  16. Procedure WriteXY(X, Y : Integer; S : String);
  17. Function  GetCharXY(X, Y : Integer) : Char;
  18. Procedure SHADE(PX, PY, QX, QY : Integer);
  19. Procedure BOX(PX, PY, QX, QY : Integer);
  20. Procedure SHADOWBOX(PX, PY, QX, QY : Integer; fg, bg : Byte);
  21.  
  22. Implementation
  23.  
  24. Procedure menubox(x1, y1, x2, y2 : Integer; fg, bg : Byte);
  25. Var
  26.   count : Integer;
  27. begin
  28.   TextColor(fg);
  29.   TextBackGround(bg);
  30.   Writexy(x1 + 1, y1, '╔');
  31.  
  32.   For count := x1 + 2 to x2 - 2 do
  33.     Writexy(count, y1, '═');
  34.  
  35.   Writexy(x2 - 1, y1, '╗');
  36.   For count := y1 + 1 to y2 - 1 do
  37.     Writexy(x1 + 1, count, '║');
  38.  
  39.   Writexy(x1 + 1, y2, '╚');
  40.   For count := y1 + 1 to y2 - 1 do
  41.     Writexy(x2 - 1, count, '║');
  42.  
  43.   Writexy(x2 - 1, y2, '╝');
  44.   For count := x1 + 2 to x2 - 2 do
  45.     Writexy(count, y2, '═');
  46. end;
  47.  
  48. Procedure WriteXY(X, Y : Integer; S : String);
  49. Var
  50.   SX, SY : Integer ;
  51. begin
  52.   SX := WhereX;
  53.   SY := WhereY;
  54.   GotoXY(X, Y);
  55.   Write(S);
  56.   GotoXY(SX, SY);
  57. end;
  58.  
  59. Function GetCharXY(X, Y : Integer) : Char;
  60. Var
  61.   Regs : Registers;
  62.   SX, SY : Integer;
  63. begin
  64.   SX := WhereX;
  65.   SY := WhereY;
  66.   GotoXY(X, Y);
  67.   Regs.AH := $08;
  68.   Regs.BH := $00;
  69.   Intr($10, Regs);
  70.   GetCharXY := Char(Regs.AL);
  71.   GotoXY(SX, SY);
  72. end;
  73.  
  74. Procedure SHADE(PX, PY, QX, QY : Integer);
  75. Var
  76.   X, Y : Integer;
  77. begin
  78.   TextColor(8);
  79.   TextBackGround(black);
  80.   For Y := PY to QY Do
  81.   For X := PX to QX Do
  82.     WriteXY(X, Y, GetCharXY(X, Y));
  83. end;
  84.  
  85. Procedure BOX(PX, PY, QX, QY : Integer);
  86. begin
  87.   Window(PX, PY, QX, QY);
  88.   ClrScr;
  89. end;
  90.  
  91. Procedure SHADOWBOX(PX, PY, QX, QY: Integer; fg, bg : Byte);
  92. begin
  93.   TextColor(fg);
  94.   TextBackGround(bg);
  95.   BOX(PX, PY, QX, QY);
  96.   Window(1, 1, 80, 25);
  97.   SHADE(PX + 2, QY + 1, QX + 2, QY + 1);
  98.   SHADE(QX + 2, PY + 1, QX + 2, QY + 1);
  99.   SHADE(QX + 1, PY + 1, QX + 1, QY + 1);
  100.   MENUBOX(PX, PY, QX, QY, fg, bg);
  101. end;
  102.  
  103. end.
  104.  
  105.